Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/v9n03.arc/PIANO.PAS

Pascal/Delphi Source File | 1990-01-12 | 6KB | 190 lines

PIANO.PAS



PROGRAM Piano;
USES CRT;

VAR
  vari : Integer;
  test, dly, intern, dlykeep : LongInt;
  flager, chartoplay : Char;
  numb, octave : Integer;
  typom, min1, adder : Real;

  PROCEDURE Play(SoundC : STRING);
    FUNCTION IsNumber(ch : CHAR) : Boolean;
    BEGIN
      IsNumber := (CH >= '0') AND (CH <= '9');
    END;

    FUNCTION value(s : STRING) : Integer;
      {Converts a string to an integer}
    VAR ss, sss : Integer;
    BEGIN
      Val(s, ss, sss);
      value := ss;
    END;

    PROCEDURE sounder(key : Char; flag : Char);
      {Plays the selected note}
    VAR
      old, New, new2 : Real;
    BEGIN
      adder := 1;
      old := dly; New := dly;
      intern := Pos(key, 'C D EF G A B')-1;
      IF (flag = '+') AND (key <> 'E') AND (key <> 'B') {See if note}
      THEN Inc(intern);                                 {is sharped }
      IF (flag = '-') AND (key <> 'F') AND (key <> 'C')
      THEN Dec(intern);                                 {or a flat. }
      WHILE SoundC[vari+1] = '.' DO
        BEGIN
          Inc(vari);
          adder := adder/2;
          New := New+(old*adder);
        END;
      new2 := (New/typom)*(1-typom);
      sound(Round(Exp((octave+intern/12)*Ln(2)))); {Play the note}
      Delay(Trunc(New));
      Nosound;
      Delay(Trunc(new2));
    END;

    FUNCTION delayer1 : Integer;
      {Calculate delay for a specified note length}
    BEGIN
      numb := value(SoundC[vari+1]);
      delayer1 := Trunc((60000/(numb*min1))*typom);
    END;

    FUNCTION delayer2 : Integer;
      {Used as above, except reads a number >10}
    BEGIN
      numb := value(SoundC[vari+1]+SoundC[vari+2]);
      delayer2 := Trunc((60000/(numb*min1))*typom);
    END;

  BEGIN                           {Play}
    SoundC := SoundC+' ';
    FOR vari := 1 TO Length(SoundC) DO
      BEGIN                       {Go through entire string}
        SoundC[vari] := Upcase(SoundC[vari]);
        {^Get a char and convert to CAPS}
        CASE SoundC[vari] OF
          'C','D','E','F','G','A','B' : BEGIN
              {^Check to see if char is a note}
              flager := ' '; dlykeep := dly;
              chartoplay := SoundC[vari];
              IF (SoundC[vari+1] = '-') OR (SoundC[vari+1] = '+')
              THEN
                BEGIN {Check for flats & sharps}
                  flager := SoundC[vari+1];
                  Inc(vari);
                END;
              IF IsNumber(SoundC[vari+1]) THEN
                BEGIN
                  IF IsNumber(SoundC[vari+2]) THEN
                    BEGIN
                      test := delayer2;
                      IF numb < 65 THEN dly := test; {Make sure # is legal}
                      Inc(vari, 2);
                    END
                  ELSE
                    BEGIN
                      test := delayer1;
                      IF numb > 0 THEN dly := test; {Make sure # is legal}
                      Inc(vari);
                    END;
                END;
              sounder(chartoplay, flager);
              dly := dlykeep;
            END;

          'O' : BEGIN             {Check for octave change}
              Inc(vari);
              CASE SoundC[vari] OF
                '-' : IF octave > 1 THEN Dec(octave);
                '+' : IF octave < 7 THEN Inc(octave);
                '1','2','3','4','5','6','7' : octave := value(SoundC[vari])+4;
              ELSE Dec(vari);
              END;
            END;

          {Check for a change in length for notes}
          'L' : IF IsNumber(SoundC[vari+1]) THEN
            BEGIN
              IF IsNumber(SoundC[vari+2]) THEN
                BEGIN
                  test := delayer2;
                  IF numb < 65 THEN dly := test; {Make sure # is legal}
                  Inc(vari, 2);
                END
              ELSE
                BEGIN
                  test := delayer1;
                  IF numb > 0 THEN dly := test; {Make sure # is legal}
                  Inc(vari);
                END;
            END;

          {Check for a pause and it's length}
          'P' : IF IsNumber(SoundC[vari+1]) THEN
            BEGIN
              IF IsNumber(SoundC[vari+2]) THEN
                BEGIN
                  test := delayer2;
                  IF numb < 65 THEN Delay(test); {Make sure # is legal}
                  Inc(vari, 2);
                END
              ELSE
                BEGIN
                  test := delayer1;
                  IF numb > 0 THEN Delay(test); {Make sure # is legal}
                  Inc(vari);
                END;
            END;

          {Check for tempo change}
          'T' : IF IsNumber(SoundC[vari+1]) AND IsNumber(SoundC[vari+2]) THEN
            BEGIN
              IF IsNumber(SoundC[vari+3]) THEN
                BEGIN
                  min1 := value(SoundC[vari+1]+SoundC[vari+2]+SoundC[vari+3]);
                  Inc(vari, 3);
                  IF min1 > 255 THEN min1 := 255; {Make sure # isn't too big}
                END
              ELSE
                BEGIN
                  min1 := value(SoundC[vari+1]+SoundC[vari+2]);
                  IF min1 < 32 THEN min1 := 32; {Make sure # isn't too short}
                END;
              min1 := min1/4;
            END;

          {Check for music type}
          'M' : BEGIN
              Inc(vari);
              CASE Upcase(SoundC[vari]) OF
                'N' : typom := 7/8; {Normal}
                'L' : typom := 1; {Legato}
                'S' : typom := 3/4; {Staccato}
              END;
            END;
        END;
      END;
  END;

BEGIN                             {Play Jingle Bells}
  Play('T255MNO5L4');
  Play('CAGFC2.P4C8C8CAGFD2.P4DB-AGE2.P4O6CCO5B-GA2.P4CAGFC2.');
  Play('P4CAGFD2P4DDB-AGO6CCCCDCO5B-GF2O6C2O5');
  Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
  Play('AGGAG2O6C2O5');
  Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
  Play('O6CCO5B-GF2.');
END.                              {PIANO}